home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0030_Play with Soundblaster.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  4KB  |  178 lines
  1. {
  2. BRIAN PAPE
  3.  
  4. Ok, here's about 45 minutes of sweating, trying to read some pitifull SB
  5. reference.  This is about as far as I've gotten trying to make the SB
  6. make some noise that is actually a note, not just a buzz...  If anyone
  7. can do ANYTHING at ALL with this, please tell me.
  8.  
  9. This program is not Copyright (c)1993 by Brian Pape.
  10. written 4/13/93
  11. It is 100% my code with nothing taken from anyone else.  If you can use it in
  12. anyway, great.  I should have the actual real version done later this summer
  13. that is more readable.  The .MOD player is about half done, pending the
  14. finishing of the code to actually play the notes (decoder is done).
  15. My fido address is 1:2250/26
  16. }
  17. program sb;
  18. uses
  19.   crt;
  20. const
  21.   on     = true;
  22.   off    = false;
  23.   maxreg = $F5;
  24.   maxch  = 10;
  25.  
  26.   note_table : array [0..12] of word =
  27.     ($000,$16b,$181,$198,$1b0,$1ca,$1e5,$202,$220,$241,$263,$287,$2ae);
  28.   key_table  : array [1..12] of char =
  29.     'QWERTYUIOP[]';
  30.   voicekey_table : array [1..11] of char =
  31.     '0123456789';
  32. type
  33.   byteset = set of byte;
  34.  
  35. var
  36.   ch        : char;
  37.   channel   : byte;
  38.   ch_active : byteset;
  39.   lastnote  : array [0..maxch] of word;
  40.  
  41.  
  42. procedure writeaddr(b : byte); assembler;
  43. asm
  44.   mov  al, b
  45.   mov  dx, 388h
  46.   out  dx, al
  47.   mov  cx, 6
  48.  
  49.  @wait:
  50.   in   al, dx
  51.   loop @wait
  52. end;
  53.  
  54. procedure writedata(b : byte); assembler;
  55. asm
  56.   mov  al, b
  57.   mov  dx, 389h
  58.   out  dx, al
  59.   mov  cx, 35h
  60.   dec  dx
  61.  
  62.  @wait:
  63.   in   al, dx
  64.   loop @wait
  65. end;
  66.  
  67. procedure sb_reset;
  68. var
  69.   i : byte;
  70. begin
  71.   for i := 1 to maxreg do
  72.   begin
  73.     writeaddr(i);
  74.     writedata(0);
  75.   end;
  76. end;
  77.  
  78. procedure sb_off;
  79. begin
  80.   writeaddr($b0);
  81.   writedata($11);
  82. end;
  83.  
  84. { r=register,d=data }
  85. procedure sb_out(r, d : byte);
  86. begin
  87.   writeaddr(r);
  88.   writedata(d);
  89. end;
  90.  
  91. procedure sb_setup;
  92. begin
  93.   sb_out($20, $01);
  94.   sb_out($40, $10);
  95.   sb_out($60, $F0);
  96.   sb_out($80, $77);
  97.   sb_out($A0, $98);
  98.   sb_out($23, $01);
  99.   sb_out($43, $00);
  100.   sb_out($63, $F0);
  101.   sb_out($83, $77);
  102.   sb_out($B0, $31);
  103. end;
  104.  
  105. procedure disphelp;
  106. begin
  107.   clrscr;
  108.   writeln;
  109.   writeln('Q:C#');
  110.   writeln('W:D');
  111.   writeln('E:D#');
  112.   writeln('R:E');
  113.   writeln('T:F');
  114.   writeln('Y:F#');
  115.   writeln('U:G');
  116.   writeln('I:G#');
  117.   writeln('O:A');
  118.   writeln('P:A#');
  119.   writeln('[:B');
  120.   writeln(']:C');
  121.   writeln('X:Quit');
  122.   writeln;
  123. end;
  124.  
  125. procedure sb_note(channel : byte; note : word; on : boolean);
  126. begin
  127.   sb_out($a0 + channel, lo(note));
  128.   sb_out($b0 + channel, ($20 * byte(on)) or $10 or hi(note));
  129. end;
  130.  
  131. procedure updatestatus;
  132. var
  133.   i : byte;
  134. begin
  135.   gotoxy(1,16);
  136.   for i := 0 to maxch do
  137.   begin
  138.     if i in ch_active then
  139.       textcolor(14)
  140.     else
  141.       textcolor(7);
  142.     write(i : 3);
  143.   end;
  144. end;
  145.  
  146. begin
  147.   sb_reset;
  148.   sb_out(1, $10);
  149.   sb_setup;
  150.   disphelp;
  151.   channel   := 0;
  152.   ch_active := [0];
  153.   repeat
  154.     updatestatus;
  155.     ch := upcase(readkey);
  156.     if pos(ch, key_table) <> 0 then
  157.     begin
  158.       lastnote[channel] := note_table[pos(ch, key_table)];
  159.       sb_note(channel, lastnote[channel], on);
  160.     end
  161.     else
  162.     if pos(ch, voicekey_table) <> 0 then
  163.     begin
  164.       channel := pred(pos(ch,voicekey_table));
  165.       if channel in ch_active then
  166.         ch_active := ch_active - [channel]
  167.       else
  168.         ch_active := ch_active + [channel];
  169.       if not (channel in ch_active) then
  170.         sb_note(channel,lastnote[channel],off)
  171.       else
  172.         sb_note(channel,lastnote[channel],on);
  173.     end;
  174.   until ch = 'X';
  175.   sb_off;
  176. end.
  177.  
  178.